home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Best of MacTutor - S…e Code for Volumes 1 to 5
/
The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin
/
Source Code
/
#40 (Jan 89)
/
FinderControls
/
MPOP texte
< prev
next >
Wrap
Text File
|
1988-04-26
|
12KB
|
430 lines
{**********************************************}
{ Put this file in the MPOP Project after DAPasLib. }
{ Don't put MacTraps that would generate unusefull glue for the Memory Manager. }
{ I prefer to declare DisposHandle as inline procedure : see below. }
{ Don't forget to "Use resource file" in "Run options" of menu "Project". }
{ This resource file must contain the MENU and ICN# resources }
{ that the PopTrap Project needs together with the compiled MDEF resource. }
{ "Build and save as…" resource code of type MDEF and ID 128 in file "MPOP code" }
{**********************************************}
UNIT MPOP;
INTERFACE
{ the name "Main" indicates to LightSpeed Pascal compiler where the entry point is }
PROCEDURE Main (message : integer;
theMenu : MenuHandle;
VAR menuRect : rect;
hitPt : point;
VAR whichItem : integer);
IMPLEMENTATION
CONST
mPopUpMsg = 3; { and not 4 as written in early versions of new MenuMgr }
PROCEDURE CopyMask (srcBits, maskBits, dstBits : BitMap;
srcRect, maskRect, dstRect : Rect);
INLINE
$A817;
PROCEDURE DisposHandle (h : handle);
{ to avoid putting the whole Memory Manager glue in our code resource }
INLINE
$205F, $A023, $31C0, $0220;
{***************************************}
{ first some utilities for reading MENU resources : }
FUNCTION GetNextByte (VAR LongAddress : longint) : byte;
INLINE
$205F, { MOVEA.L (A7)+,A0 }
$2250, { MOVEA.L (A0),A1 }
$5290, { ADDQ.L #$1,(A0) }
$204F, { MOVEA.L A7,A0 }
$4218, { CLR.B (A0)+ }
$1091; { MOVE.B (A1),(A0) }
FUNCTION GetNextInteger (VAR LongAddress : longint) : integer;
INLINE
$205F, { MOVEA.L (A7)+,A0 }
$2250, { MOVEA.L (A0),A1 }
$5490, { ADDQ.L #$2,(A0) }
$204F, { MOVEA.L A7,A0 }
$10D9, { MOVE.B (A1)+,(A0)+ }
$1091; { MOVE.B (A1),(A0) }
FUNCTION GetNextString (VAR LongAddress : longint) : StringHandle;
{ returns NIL if allocation failed }
INLINE
$205F, { MOVEA.L (A7)+,A0 ;A0:=@LongAddress }
$2250, { MOVEA.L (A0),A1 ;A1:=LongAddress }
$7000, { MOVEQ #$00,D0 ;countChars:=0 }
$1011, { MOVE.B (A1),D0 ;countChars:=LongAddress^ }
$2200, { MOVE.L D0,D1 ;save countChars }
$5200, { ADDQ.B #$1,D0 ;length:=countChars+1 }
$D190, { ADD.L D0,(A0) ;FuturLongAddress:=LongAddress+length }
$A122, { OSTRAP $A122 ;A0:=NewHandle(D0=length) }
$4A80, { TST.L D0 ;if MemError }
$660C, { BNE.S *+$000E ;<>0 goto error }
$2E88, { MOVE.L A0,(A7) ;GetChaine:=A0 }
$2050, { MOVEA.L (A0),A0 ;StringPtr }
{ loop ;repeat }
$10D9, { MOVE.B (A1)+,(A0)+ ;StringPtr^:=LongAddress^ }
$51C9, $FFFC, { DBF D1,*-$0002 ;dec(length); until length<0 }
$6002, { BRA.S *+$0004 ;goto bottom }
{ error }
$4297; { CLR.L (A7) ;GetChaine:=NIL }
{ bottom }
FUNCTION SkipNextString (VAR LongAddress : longint) : byte;
VAR
length : byte;
BEGIN
length := GetNextByte(LongAddress);
LongAddress := LongAddress + length;
SkipNextString := length;
END;
PROCEDURE SkipBytes (VAR LongAddress : longint;
byteCount : integer);
BEGIN
LongAddress := LongAddress + byteCount;
END;
{***************************************}
PROCEDURE Main;
FUNCTION GetItemCenter : point;
{ returns the ItemCenter in local coordinates, relative to menuRect }
{ theMenu is allready locked }
VAR
LongAddress : longint;
length : byte;
i : integer;
ItemCenter : point;
BEGIN
LongAddress := ord(theMenu^) + 14;
length := SkipNextString(LongAddress);
i := 0;
REPEAT
i := i + 1;
length := SkipNextString(LongAddress);
IF length > 0 THEN
BEGIN
IF i = whichItem THEN
BEGIN
ItemCenter.v := GetNextInteger(LongAddress);
ItemCenter.h := GetNextInteger(LongAddress);
END
ELSE
BEGIN
SkipBytes(LongAddress, 4);
END;
END
ELSE { if length<=0 : }
SetPt(ItemCenter, 0, 0);
UNTIL (length <= 0) OR (i = whichItem);
GetItemCenter := ItemCenter;
END;
{***************************************}
PROCEDURE DoDrawMessage;
PROCEDURE PinString (theString : Str255;
center : point);
BEGIN
WITH center DO
MoveTo(h - StringWidth(theString) DIV 2, v);
DrawString(theString);
END;
PROCEDURE PlotIconDataCopy (theIcon : handle;
dstSquare : rect);
VAR
srcSquare : rect;
data : bitmap;
myPort : GrafPtr;
BEGIN
IF (theIcon <> NIL) THEN
BEGIN
SetRect(srcSquare, -16, -16, 16, 16);
data.rowBytes := 4;
data.baseAddr := ptr(theIcon^);
data.bounds := srcSquare;
GetPort(myPort);
CopyBits(data, myPort^.portbits, srcSquare, dstSquare, srcCopy, NIL);
END;
END;
VAR
IconRect : rect;
IconName : StringHandle;
LongAddress : longint;
NameLength : byte;
ItemCenter, TextCenter : point;
theIcon : handle;
BEGIN
LongAddress := ord(theMenu^) + 14;
NameLength := SkipNextString(LongAddress);
REPEAT
IconName := GetNextString(LongAddress);
NameLength := length(IconName^^);
IF NameLength > 0 THEN
BEGIN
theIcon := GetNamedResource('ICN#', IconName^^);
ItemCenter.v := GetNextInteger(LongAddress) + menuRect.top;
ItemCenter.h := GetNextInteger(LongAddress) + menuRect.left;
WITH ItemCenter DO
BEGIN
SetRect(IconRect, h - 16, v - 21, h + 16, v + 11);
SetPt(TextCenter, h, v + 20);
END;
PlotIconDataCopy(theIcon, IconRect);
TextFont(geneva);
TextSize(9);
PinString(IconName^^, TextCenter);
TextFont(systemFont);
TextSize(12);
END;
DisposHandle(handle(IconName));
UNTIL NameLength <= 0;
END; { of DoDrawMessage }
{***************************************}
PROCEDURE DoChooseMessage;
FUNCTION GetIconRect : rect;
{ returns the IconRect in global coordinates }
VAR
ItemCenter : point;
IconRect : rect;
BEGIN
ItemCenter := GetItemCenter;
WITH ItemCenter DO
BEGIN
IF (h = 0) AND (v = 0) THEN
SetRect(IconRect, 0, 0, 0, 0)
ELSE
SetRect(IconRect, h - 16, v - 21, h + 16, v + 11);
END;
WITH menuRect DO
OffSetRect(IconRect, left, top);
GetIconRect := IconRect;
END; { of GetIconRect }
PROCEDURE PlotIconMaskXor (theIcon : handle;
dstSquare : rect);
VAR
srcSquare : rect;
mask : bitmap;
myPort : GrafPtr;
BEGIN
IF (theIcon <> NIL) THEN
BEGIN
SetRect(srcSquare, -16, -16, 16, 16);
mask.rowBytes := 4;
mask.baseAddr := ptr(ord4(theIcon^) + 128);
mask.bounds := srcSquare;
GetPort(myPort);
CopyBits(mask, myPort^.portbits, srcSquare, dstSquare, srcXOr, NIL);
END;
END; { of PlotIconMaskXor }
FUNCTION GetIconName (whichItem : integer) : StringHandle;
{ theMenu is allready locked }
VAR
LongAddress : longint;
length : byte;
i : integer;
IconName : StringHandle;
BEGIN
LongAddress := ord(theMenu^) + 14;
length := SkipNextString(LongAddress);
i := 0;
REPEAT
i := i + 1;
IF i = whichItem THEN
BEGIN
IconName := GetNextString(LongAddress);
END
ELSE
BEGIN
length := SkipNextString(LongAddress);
IF length > 0 THEN
SkipBytes(LongAddress, 4)
ELSE
IconName := NIL;
END;
UNTIL (length <= 0) OR (i = whichItem);
GetIconName := IconName;
END;
PROCEDURE InvertIcon (whichItem : integer;
dstSquare : rect);
VAR
IconName : StringHandle;
myIcon : handle;
BEGIN
IconName := GetIconName(whichItem);
myIcon := GetNamedResource('ICN#', IconName^^);
PlotIconMaskXor(myIcon, dstSquare);
END;
VAR
itemNumber : integer;
NameLength : byte;
LongAddress : longint;
ItemCenter : point;
ItemRect, OldIconRect, IconRect : rect;
BEGIN { DoChooseMessage }
LongAddress := ord(theMenu^) + 14;
NameLength := SkipNextString(LongAddress);
itemNumber := 0;
REPEAT
itemNumber := itemNumber + 1;
NameLength := SkipNextString(LongAddress);
IF NameLength > 0 THEN
BEGIN
ItemCenter.v := GetNextInteger(LongAddress);
ItemCenter.h := GetNextInteger(LongAddress);
WITH ItemCenter DO
SetRect(ItemRect, h - 25, v - 25, h + 25, v + 25);
WITH menuRect DO
OffSetRect(ItemRect, left, top);
END;
UNTIL (NameLength <= 0) OR (PtInRect(hitPt, ItemRect));
IF NameLength <= 0 THEN { hitPt is not in any item }
BEGIN
IF whichItem <> 0 THEN
BEGIN
InvertIcon(whichItem, GetIconRect);
whichItem := 0;
END;
END
ELSE IF itemNumber <> whichItem THEN { hitPt is in itemRect }
BEGIN
IF whichItem <> 0 THEN
InvertIcon(whichItem, GetIconRect);
WITH ItemCenter DO
SetRect(IconRect, h - 16, v - 21, h + 16, v + 11);
WITH MenuRect DO
OffSetRect(IconRect, left, top);
InvertIcon(itemNumber, IconRect);
whichItem := itemNumber;
END;
END; { of DoChooseMessage }
{***************************************}
PROCEDURE DoSizeMessage;
{ theMenu is allready locked }
PROCEDURE RectAndPt (VAR theRect : rect;
thePoint : point);
BEGIN
WITH theRect, thePoint DO
{ we suppose that 0=left<right and 0=top<bottom }
BEGIN
IF h > right THEN
right := h;
IF v > bottom THEN
bottom := v;
END;
END;
VAR
LongAddress : longint;
length : byte;
ItemCenter : point;
Envelope : rect;
BEGIN
LongAddress := ord(theMenu^) + 14;
length := SkipNextString(LongAddress);
SetRect(Envelope, 0, 0, 0, 0);
REPEAT
length := SkipNextString(LongAddress);
IF length > 0 THEN
BEGIN
ItemCenter.v := GetNextInteger(LongAddress);
ItemCenter.h := GetNextInteger(LongAddress);
RectAndPt(envelope, ItemCenter);
END
UNTIL (length <= 0);
WITH theMenu^^, envelope DO
BEGIN
menuWidth := right + 25;
menuHeight := bottom + 25;
END;
END; { of DoSizeMessage }
{***************************************}
PROCEDURE DoPopUpMessage;
{ on entry: whichItem(=popUpItem) , }
{ hitPt (= center of title icon) }
{ theMenu (Locked) }
{ on exit : menuRect }
{ ThePort is allready set to WindowManager Port }
VAR
ItemCenter, IconCenter : point;
dh, dv : integer;
WMPort : GrafPtr;
mBarHeight : ^integer;
BEGIN
mBarHeight := pointer($BAA);
WITH theMenu^^, hitPt DO
SetRect(menuRect, h, v, h + menuWidth, v + MenuHeight);
IF whichItem > 0 THEN
BEGIN
ItemCenter := GetItemCenter;
WITH ItemCenter DO
SetPt(IconCenter, h, v - 5);
WITH IconCenter DO
IF NOT ((h = 0) AND (v = 0)) THEN
OffSetRect(menuRect, -h, -v)
ELSE
whichItem := 0;
END;
IF whichItem <= 0 THEN
OffSetRect(menuRect, -25, +25);
GetPort(WMPort);
WITH WMPort^ DO
BEGIN
IF menuRect.right + 8 > PortRect.right THEN
dh := PortRect.right - menuRect.right - 8
ELSE IF menuRect.left - 8 < PortRect.left THEN
dh := PortRect.left - menuRect.left + 8
ELSE
dh := 0;
IF menuRect.bottom + 8 > PortRect.bottom THEN
dv := PortRect.bottom - menuRect.bottom - 8
ELSE IF menuRect.top - 8 < PortRect.top + mBarHeight^ THEN
dv := PortRect.top + mBarHeight^ - menuRect.top + 8
ELSE
dv := 0;
END;
OffSetRect(menuRect, dh, dv);
END; { of DoPopUpMessage }
{***************************************}
BEGIN { of Main }
CASE message OF
mSizeMsg :
DoSizeMessage;
mDrawMsg :
DoDrawMessage;
mChooseMsg :
DoChooseMessage;
mPopUpMsg :
DoPopUpMessage;
END;
END;
END.
